home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / lib / xfont.pro < prev    next >
Text File  |  1997-07-08  |  14KB  |  440 lines
  1. ; $Id: xfont.pro,v 1.11 1997/01/15 03:11:50 ali Exp $
  2. ;
  3. ; Copyright (c) 1991-1997, Research Systems, Inc.  All rights reserved.
  4. ;    Unauthorized reproduction prohibited.
  5. ;+
  6. ; NAME:
  7. ;    XFONT
  8. ;
  9. ; PURPOSE:
  10. ;    XFONT is a modal widget for selecting and viewing an X Windows font.
  11. ; 
  12. ; CATEGORY:
  13. ;    Widgets, Fonts
  14. ;
  15. ; CALLING SEQUENCE:
  16. ;    Selected_font = XFONT()
  17. ;
  18. ; INPUTS:
  19. ;    No explicit inputs.
  20. ;
  21. ; KEYWORD PARAMETERS:
  22. ;    GROUP:    The widget ID of the widget that calls XFONT. When this
  23. ;          ID is specified, a death of the caller results in a death
  24. ;          of XFONT.
  25. ;    PRESERVE: If set, XFONT saves the server font directory in common
  26. ;          blocks so that subsequent calls to XFONT start-up much
  27. ;          faster. If not set, the common block is cleaned.
  28. ;
  29. ; OUTPUTS:
  30. ;    A string containing the font name.  If nothing is selected, or
  31. ;    the CANCEL button is pressed, a null string is returned.
  32. ;
  33. ; COMMON BLOCKS:
  34. ;    XFONT_COM.
  35. ;
  36. ; SIDE EFFECTS:
  37. ;    Initiates the XManager if it is not already running.
  38. ;    Resets the current X Window font.  
  39. ;
  40. ; RESTRICTIONS:
  41. ;    The current X window font is manipulated without being restored.
  42. ;    This routine does not work on non-X Windows platforms (i.e., Windows
  43. ;    and Macintosh).
  44. ;
  45. ; PROCEDURE:
  46. ;    Create and register the widget and then exit.
  47. ;
  48. ; MODIFICATION HISTORY:
  49. ;    Modified from a template written by: Hans-Joachim Bothe, CreaSo GmbH,
  50. ;        November, 1991, by DMS, RSI, November, 1992.
  51. ;    1 July 1995, AB, Fixed sizing of toggle buttons.
  52. ;    6 July 1995, MWR, Added platform check to return to caller if 
  53. ;        running on Windows or Macintosh.
  54. ;-
  55.  
  56.  
  57.  
  58.  
  59. FUNCTION xfont_select, sstring        ;Find fonts matching sstring
  60. ;  Return -1 if none there....
  61. common xfont_com, s, f, xreg, private, nfields, nreg, uniqi, uniqs, $
  62.     t_buttons, t_list, s_list, s_string, t_button_select, t_text, $
  63.     l_text, to_do, t_selections, selected_font, view_text, $
  64.     view_window, reg_base, priv, display_string, s_text, preserve, $
  65.     point_base, point_txt, size_index
  66.  
  67.  
  68.  
  69. l = replicate(1b, nreg)            ;Matching fonts so far
  70.  
  71. for i=0, n_elements(to_do)-1 do begin
  72.     if s_string[i] ne '*' then begin  ;Search this field
  73.         bad = where(f[i,*] ne s_string[i], count)
  74.         if count gt 0 then l[bad] = 0
  75.         endif
  76.     endfor
  77. return, where(l)
  78. end
  79.  
  80.  
  81. FUNCTION xfont_scal_fname, name
  82. ; Given a font name, s.  See if field 8 (the size field, counting the
  83. ; first '-') contains the string '0'.  If so, substitute the contents of 
  84. ; the point_size text widget, followed by -75-75.
  85. ;    
  86. common xfont_com, s, f, xreg, private, nfields, nreg, uniqi, uniqs, $
  87.     t_buttons, t_list, s_list, s_string, t_button_select, t_text, $
  88.     l_text, to_do, t_selections, selected_font, view_text, $
  89.     view_window, reg_base, priv, display_string, s_text, preserve, $
  90.     point_base, point_txt, size_index
  91.  
  92. t = str_sep(name, '-')
  93. if n_elements(t) lt 11 then return, name
  94. if fix(t[8]) ne 0 then return, name
  95. widget_control, point_txt, GET_VALUE = x
  96. if fix(x[0]) eq 0 then return, name    ;No size specified
  97. t[8] = x        ;Substitute point size
  98. t[9] = '75'        ;Diddle our fields
  99. t[10] = '75'
  100. n = n_elements(t)
  101. r = ''
  102. for i=1, n_elements(t)-1 do r = r + '-' + t[i]   ;Re-combine
  103.  
  104. return ,r
  105. end
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112. PRO xfont_event, event            ;Main & only event procedure
  113.                      
  114. common xfont_com, s, f, xreg, private, nfields, nreg, uniqi, uniqs, $
  115.     t_buttons, t_list, s_list, s_string, t_button_select, t_text, $
  116.     l_text, to_do, t_selections, selected_font, view_text, $
  117.     view_window, reg_base, priv, display_string, s_text, preserve, $
  118.     point_base, point_txt, size_index
  119.  
  120.  
  121.  
  122. WIDGET_CONTROL, event.top, /HOURGLASS
  123. WIDGET_CONTROL, event.id, GET_UVALUE=eventval
  124.  
  125.    ; Determine event type
  126.  
  127. CASE eventval OF
  128.  
  129.     "TBUTTON": BEGIN        ;Font-type button
  130.     if t_button_select ne -1 then $
  131.         widget_control, t_buttons[t_button_select], $
  132.             SET_BUTTON = 0  ;Remove prev
  133.     t_button_select = (where(event.id eq t_buttons))[0]  ;New button
  134.     n = t_button_select
  135.     s_string[n] = '*'    ;Make this one wild
  136.     WIDGET_CONTROL, t_text[n], SET_VALUE = '*'
  137.     q = xfont_select(s_string)    ;Fonts OK so far.
  138.  
  139.     if q[0] ne -1 then begin    ;Anything there?
  140.         t_strings = f[n,q]    ;Names that we can select
  141.         t_selections = uniq(t_strings, sort(t_strings))
  142.         t_selections = t_strings[t_selections]
  143.     endif else t_selections = '<Nothing Matches>'
  144.     WIDGET_CONTROL, t_list, set_value = t_selections
  145.     goto, update_s_list
  146.     ENDCASE
  147.     
  148.     "T_LIST": BEGIN        ;Picked a list item
  149.     if t_button_select eq -1 then return
  150.     s_string[t_button_select] = t_selections[event.index]
  151.     WIDGET_CONTROL, t_text[t_button_select], $
  152.         SET_VALUE = t_selections[event.index]
  153.     q = xfont_select(s_string)    ;Matching fonts
  154.     if t_button_select eq size_index then begin
  155.         i =  s_string[size_index] eq '0' 
  156.         WIDGET_CONTROL, point_base, MAP=i
  157.         endif
  158.     update_s_list:
  159.     selected_font = -1
  160.     if q[0] ne -1 then BEGIN
  161.         WIDGET_CONTROL, s_list, SET_VALUE=s[xreg[q]]
  162.         selected_font = xreg[q[0]]
  163.     ENDIF ELSE WIDGET_CONTROL, s_list, SET_VALUE = '<No matching fonts>'
  164.     WIDGET_CONTROL, l_text, SET_VALUE= strtrim(n_elements(q),2) + $
  165.        ' matching fonts.'
  166.     goto, view_font
  167.     ENDCASE    
  168.  
  169.     "S_LIST": BEGIN
  170.     if priv then selected_font = private[event.index] $
  171.     else begin
  172.         q = xfont_select(s_string)    ;Matching fonts
  173.         selected_font = xreg[q[event.index]]
  174.     endelse
  175. ;     print,s(selected_font)
  176.   view_font:
  177.     if selected_font lt 0 then begin
  178.         WIDGET_CONTROL, view_text, SET_VALUE = 'No font selected'
  179.         return
  180.         endif
  181.     font = xfont_scal_fname(s[selected_font])
  182.     WIDGET_CONTROL, view_text, SET_VALUE=font
  183.     swin = !d.window
  184.     wset, view_window
  185.     erase
  186.     device, font = font
  187.     xyouts, 10, !d.y_size - 1.5 * !d.y_ch_size, /DEV, /FONT, display_string
  188.     wset, swin
  189.     ENDCASE
  190.     "PRIV":  BEGIN
  191.     WIDGET_CONTROL, reg_base, map=0
  192.     WIDGET_CONTROL, s_list, SET_VALUE = s[private]
  193.     priv = 1
  194.     ENDCASE
  195.     "REG":   BEGIN
  196.     WIDGET_CONTROL, reg_base, map=1
  197.     priv = 0
  198.     q = xfont_select(s_string)    ;Matching fonts
  199.     goto, update_s_list
  200.     ENDCASE
  201.  
  202.     "DRAW": WIDGET_CONTROL, event.top, /DESTROY   ;Clicked draw window
  203.  
  204.     "VIEW": BEGIN
  205.     if selected_font lt 0 then return
  206.     device, font = xfont_scal_fname(s[selected_font])
  207.     junk = WIDGET_BASE(title = s[selected_font])
  208.     chx = !d.x_ch_size * 2. > 8    ;X Spacing
  209.     chy = !d.y_ch_size * 1.7 > 12    ;Y Spacing
  210.     draw = WIDGET_DRAW(junk, xsize = chx * 18, ysize = chy * 18, $
  211.         /BUTTON_EVENTS, UVALUE="DRAW", RET=2)
  212.     WIDGET_CONTROL, junk, /realize
  213.     WIDGET_CONTROL, draw, GET_VALUE = i
  214.     swin = !D.WINDOW
  215.     WSET, i
  216.     for i=0,15 do xyouts, (i+2)*chx, !d.y_size - chy, /DEV, $
  217.         string(i, format='(z1)')
  218.     for i= 0, 15 do begin
  219.         y = !d.y_size - (i+2) * chy
  220.         xyouts, 0, y, /DEV, string(i, format='(z1)')
  221.         k = i*16
  222.         for j=0, 15 do $
  223.             if j+k ne 0 then xyouts, (j+2) *chx, y, /DEV, /FONT, $
  224.                 string(byte(j+k))
  225.         ENDFOR
  226.     WSET, swin
  227.     XMANAGER, 'xfont', junk, EVENT_HANDLER = 'xfont_event', $
  228.         GROUP_LEADER = event.top
  229.     ENDCASE
  230.     "HELP": BEGIN
  231. ;    xdisplayfile, 'xfont.txt', $    ;Debugging
  232.     xdisplayfile, filepath("xfont.txt", subdir=['help', 'widget']), $  ;Working
  233.         title = "xfont help", $
  234.         group = event.top, $
  235.         width = 72, height = 24
  236.     ENDCASE
  237.  
  238.     "STEXT": BEGIN
  239.     WIDGET_CONTROL, s_text, GET_VALUE = display_string
  240.     display_string = display_string[0]
  241.     goto, view_font
  242.     ENDCASE
  243.  
  244.     "PTXT": goto, view_font    
  245.     "DONE": BEGIN
  246.     if selected_font ge 0 then begin
  247.         s_string = xfont_scal_fname(s[selected_font])
  248.         goto, exit
  249.         endif
  250.     ENDCASE
  251.     "CANCEL": BEGIN
  252.     selected_font = -1
  253.     exit:
  254.     WIDGET_CONTROL, event.top, /DESTROY
  255.     if preserve eq 0 then BEGIN    ;Clean up space consuming arrays
  256.         f = 0
  257.         if selected_font ge 0 then s = s[selected_font] else s = ''
  258.         private = 0
  259.         uniqs = 0
  260.         xreg = 0
  261.         ENDIF
  262.     ENDCASE
  263. ENDCASE
  264. END
  265.  
  266.  
  267.  
  268.  
  269. Function xfont, GROUP = GROUP, PRESERVE_FONT_INFO = pres
  270.  
  271. common xfont_com, s, f, xreg, private, nfields, nreg, uniqi, uniqs, $
  272.     t_buttons, t_list, s_list, s_string, t_button_select, t_text, $
  273.     l_text, to_do, t_selections, selected_font, view_text, $
  274.     view_window, reg_base, priv, display_string, s_text, preserve, $
  275.     point_base, point_txt, size_index
  276.                      
  277.  
  278.    ; Return to caller if run on Windows or Macintosh since this routine
  279.    ; only applies to X Windows platforms.
  280.    ON_ERROR, 2                     ;Return to caller if an error occurs
  281.    IF (!VERSION.OS_FAMILY EQ 'Windows' OR $
  282.        !VERSION.OS_FAMILY EQ 'MacOS') THEN BEGIN
  283.       MESSAGE,"This routine is not supported on this platform.",/CONTINUE
  284.       RETURN,''
  285.    ENDIF
  286.  
  287.    ; Check for other copies and do nothing if xfont is already running:
  288.  
  289.    IF(XRegistered('xfont') NE 0) THEN RETURN, ''
  290.  
  291.    if n_elements(pres) gt 0 then preserve = pres else preserve = 0
  292.    pwin = -1
  293.    selected_font = -1
  294.    t_button_select = -1
  295.    priv = 0
  296.    display_string = 'The quick brown fox jumped over the lazy dog.' + $
  297.     '!C!CABCDEFG abcdefg 01234567'
  298.  
  299.    to_do = [ 0,1,2,3,4,7 ]    ;Fields we care about
  300.    m = n_elements(to_do)
  301.    field_names = [ 'Foundry', 'Family', 'Weight', 'Slant', 'Width', $
  302.         'Size' ]
  303.    t_buttons = lonarr(m)
  304.    t_text = lonarr(m)
  305.    s_string = replicate('*', m)
  306.    size_index = 5        ;The index of the point size field
  307.  
  308.  
  309.    if !d.window lt 0 then $    ;So we don't create an empty window
  310.     window, /pix, xs=100, ys=100, /free, pwin
  311.  
  312.    if n_elements(s) gt 1 then goto, processed_fonts  ;Saved info?
  313.    t0 = systime(1)
  314.    device, font ='*', get_fontname=s      ;Get the fonts
  315.    nf = n_elements(s)            ;# of fonts
  316.  
  317.    char1 = strmid(s, 0, 1)        ;Parse fontname strings
  318.    ext = where(char1 eq '+', count)      ;Any Font name extensions?
  319.    for i=0, count-1 do begin        ;Remove them
  320.     j = ext[i]
  321.     s[j] = strmid(s[j], strpos(s[j], '-'), 1000)
  322.     endfor
  323.                 ;Separate the X window fonts
  324.    if count gt 0 then xreg = [ where(char1 eq '-'), ext ] $
  325.    else xreg = where(char1 eq '-')
  326.  
  327.    private = lonarr(nf)        ;Get private fonts
  328.    private[xreg] = 1        ;Ones that are X
  329.    private = where(private eq 0)  ;Ones that aren't
  330.    private = private[sort(s[private])]  ;Sort into lexical order
  331.  
  332.    nreg = n_elements(xreg)    ; Separate information from font names
  333.  
  334.    f = strarr(m, nreg)        ;Fields we care about
  335.    nfields = max(to_do)
  336.    this_one = replicate(-1, nfields+1)  ;-1 in fields we don't want
  337.    this_one[to_do] = indgen(m)    ;Index in ones we do
  338.  
  339.    for j=0, nreg-1 do begin    ;Each registered font
  340.     t = s[xreg[j]]        ;The string
  341.     anchor = 1        ;1st char to search
  342.     for i=0, nfields do begin    ;Extract each field
  343.         n = strpos(t, '-', anchor)
  344.         k = this_one[i]
  345.         if k ge 0 then begin
  346.            tt = strmid(t, anchor, n - anchor)
  347.            if tt eq '' then f[k,j] = '<blank>' else f[k,j] = tt
  348.            endif
  349.         anchor = n + 1
  350.         endfor
  351.     endfor
  352.  
  353.    uniqi = lonarr(m+1)        ;Indices to unique names
  354.    
  355.    for i=0L, m-1 do begin    ;Get unique items for each field
  356.     t = f[i,*]
  357.     t = uniq(t, sort(t))
  358.     uniqi[i+1] = n_elements(t) + uniqi[i]    ;Startind indices
  359.     if i eq 0 then uniqs = t $
  360.     else uniqs = [ uniqs, t]
  361.     endfor
  362. ;   print, systime(1) - t0, ' seconds getting fonts'
  363.  
  364.  
  365. processed_fonts:
  366.    xfontbase = WIDGET_BASE(TITLE='Font Widget', /COLUMN)
  367.    junk = WIDGET_BASE(xfontbase, /ROW)
  368.    junk1 = WIDGET_BUTTON(junk, value = "OK", UVALUE = "DONE", /NO_REL)
  369.    junk1 = WIDGET_BUTTON(junk, value = "Cancel", UVALUE = "CANCEL", /NO_REL)
  370.    junk1 = WIDGET_BUTTON(junk, value = "View", UVALUE = "VIEW", /NO_REL)
  371.    junk1 = WIDGET_BUTTON(junk, value = "Help", UVALUE = "HELP", /NO_REL)
  372.    junk1 = WIDGET_BASE(junk, /ROW, /EXCLUSIVE)
  373.    junk2 = WIDGET_BUTTON(junk1, VALUE = 'Registered', UVALUE='REG')
  374.    junk3 = WIDGET_BUTTON(junk1, VALUE = 'Private', UVALUE='PRIV')
  375.    WIDGET_CONTROL, junk2, SET_BUTTON=1
  376.    
  377.    point_base = WIDGET_BASE(junk, /ROW, /FRAME)
  378.    junk2 = WIDGET_LABEL(point_base, VALUE='deciPoint Size:')
  379.    point_txt = WIDGET_TEXT(point_base, xsize=4, /EDIT, value='120', $
  380.         UVALUE='PTXT')
  381.    WIDGET_CONTROL, point_base, MAP=0
  382.  
  383.    reg_base = WIDGET_BASE(xfontbase, /ROW)
  384.    lbase = WIDGET_BASE(reg_base, /COLUMN)
  385.    rbase = WIDGET_BASE(reg_base, /COLUMN)
  386.  
  387.    for i=0, n_elements(to_do)-1 do begin    ;Make exclusive bases
  388.     j = to_do[i]
  389.     junk = widget_base(lbase, /ROW, /FRAME)
  390.     junk2 = WIDGET_BASE(junk, /EXCLUSIVE)
  391.     t_buttons[i] = $
  392.         WIDGET_BUTTON(junk2, value= field_names[i], /NO_RELEASE, $
  393.             UVALUE='TBUTTON')
  394.     t_text[i] = WIDGET_TEXT(junk, value = '*', ysize=1, xsize=24)
  395.     endfor
  396.    ; Set all the buttons to the width of the widest
  397.    junk = max(strlen(field_names), junk2)
  398.    geo = WIDGET_INFO(t_buttons[junk2], /geometry)
  399.    for i=0, n_elements(to_do)-1 do $
  400.        widget_control, scr_xsize=geo.scr_xsize, t_buttons[i]
  401.  
  402.    l_text = WIDGET_TEXT(lbase, /FRAME, xsize = 32)
  403.  
  404.    t_list = WIDGET_LIST(rbase, value = string(replicate(77b,24)), $
  405.             UVALUE = 'T_LIST', ysize = 9)
  406.  
  407.    base = xfontbase
  408.    s_list = WIDGET_LIST(base, value = string(replicate(77b,56)), $
  409.             UVALUE = 'S_LIST', ysize = 8)
  410.  
  411.    junk  = WIDGET_BASE(base, /ROW, /FRAME)
  412.    junk1 = WIDGET_LABEL(junk, VALUE='Current font:')
  413.    view_text = WIDGET_TEXT(junk, value = string(replicate(77B, 64)), $
  414.         XSIZE=64)
  415.  
  416.    junk = WIDGET_BASE(base, /ROW, /FRAME)
  417.    junk1 = WIDGET_LABEL(junk, VALUE='Display Text:')
  418.    s_text = WIDGET_TEXT(junk, value = display_string, $
  419.         XSIZE=64, UVALUE = "STEXT", /EDIT)
  420.  
  421.    view_draw = WIDGET_DRAW(base, xsize = 400, ysize=120, RETAIN = 2)
  422.    
  423.    WIDGET_CONTROL, xfontbase, /REALIZE
  424.  
  425.    WIDGET_CONTROL, t_list, SET_VALUE=' '    ;Remove beginning junk
  426.    WIDGET_CONTROL, s_list, SET_VALUE=' '
  427.    WIDGET_CONTROL, view_text, SET_VALUE=' '
  428.    WIDGET_CONTROL, view_draw, GET_VALUE = view_window
  429.  
  430.    ; Register the widgets with the XManager.
  431.  
  432.    if pwin ge 0 then wdelete, pwin        ;Clean up initialization
  433.    XManager, 'xfont', xfontbase, $
  434.                 EVENT_HANDLER = 'xfont_event', $
  435.         GROUP_LEADER = GROUP
  436.  
  437.    if selected_font lt 0 then return, '' else $
  438.     return, s_string
  439. END
  440.